home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HyperLib 1997 Winter - Disc 1
/
HYPERLIB-1997-Winter-CD1.ISO.7z
/
HYPERLIB-1997-Winter-CD1.ISO
/
オンラインウェア
/
PRG
/
MacPerl 506 appl folder.sit
/
MacPerl 506 appl folder
/
Mac_Perl_506r1m_appl
/
lib
/
macftp.pl
< prev
next >
Wrap
Perl Script
|
1993-10-23
|
10KB
|
416 lines
#!/usr/local/bin/perl
# This is a set of ftp library routines using chat2.pl
#
# Return code information taken from RFC 959
# Written by Gene Spafford <spaf@cs.purdue.edu>
# Last update: 10 April 92, Version 0.9
#
# put() and port to MacPerl M. Neeracher <neeri@iis.ethz.ch>
#
# Most of these routines communicate over an open ftp channel
# The channel is opened with the "ftp'open" call.
#
package ftp;
require "macchat.pl";
require "GUSI.ph";
###########################################################################
#
# The following are the variables local to this package.
# I declare them all up front so I can remember what I called 'em. :-)
#
###########################################################################
LOCAL_VARS: {
$Control;
$Data_handle;
$Host;
$Myhost = "Some.Poor.Mac";
# Currently no way to do gethostname
$NeedsCleanup;
$NeedsClose;
$ftp_error;
$ftp_matched;
$ftp_trans_flag;
$ftp_echo;
@ftp_list;
local(@tmp) = getservbyname("ftp", "tcp");
($FTP = $tmp[2]) ||
die "Unable to get service number for 'ftp' (in ftplib)!¥n";
@std_actions = (
'TIMEOUT',
q($ftp_error = "Connection timed out for $Host!¥n"; undef),
'EOF',
q($ftp_error = "Connection to $Host timed out unexpectedly!¥n"; undef)
);
@sigs = ('INT', 'HUP', 'TERM', 'QUIT'); # sigs we'll catch & terminate on
}
###########################################################################
#
# The following are intended to be the user-callable routines.
# Each of these does one of the ftp keyword functions.
#
###########################################################################
sub error { ## Public
$ftp_error;
}
sub echo { ## Public
($ftp_echo) = @_;
}
#######################################################
# cd up a directory level
sub cdup { ## Public
&do_ftp_cmd(200, "cdup");
}
#######################################################
# close an open ftp connection
sub close { ## Public
return unless $NeedsClose;
&do_ftp_cmd(221, "quit");
&macchat'close($Control);
undef $NeedsClose;
&do_ftp_signals(0);
}
#######################################################
# change remote directory
sub cwd { ## Public
&do_ftp_cmd(250, "cwd", @_);
}
#######################################################
# delete a remote file
sub delete { ## Public
&do_ftp_cmd(250, "dele", @_);
}
#######################################################
# get a directory listing of remote directory ("ls -l")
sub dir { ## Public
&do_ftp_listing("list", @_);
}
#######################################################
# get a remote file to a local file
# get(remote[, local])
sub get { ## Public
local($remote, $local) = @_;
($local = $remote) unless $local;
unless (open(DFILE, ">$local")) {
$ftp_error = "Open of local file $local failed: $!";
return undef;
} else {
$NeedsCleanup = $local;
}
return undef unless &do_open_dport; # Open a data channel
unless (&do_ftp_cmd(150, "retr $remote")) {
$ftp_error .= "¥nFile $remote not fetched from $Host¥n";
close DFILE;
unlink $local;
undef $NeedsCleanup;
return;
}
$ftp_trans_flag = 0;
do {
&macchat'expect($Data_handle, 60,
'.|¥n', q{$macchat'thisbuf =~ s|¥015¥012|¥n|g;
print DFILE ($macchat'thisbuf) ||
($ftp_trans_flag = 3); undef $macchat'S},
'EOF', '$ftp_trans_flag = 1',
'TIMEOUT', '$ftp_trans_flag = 2');
} until $ftp_trans_flag;
close DFILE;
&macchat'close($Data_handle); # Close the data channel
undef $NeedsCleanup;
if ($ftp_trans_flag > 1) {
unlink $local;
$ftp_error = "Unexpected " . ($ftp_trans_flag == 2 ? "timeout" :
($ftp_trans_flag != 3 ? "failure" : "local write failure")) .
" getting $remote¥n";
}
&do_ftp_cmd(226);
}
#######################################################
# put a local file to a remote file
# put(local[, remote])
sub put { ## Public
local($local, $remote) = @_;
($remote = $local) unless $remote;
unless (open(DFILE, "<$local")) {
$ftp_error = "Open of local file $local failed: $!";
return undef;
}
return undef unless &do_open_dport; # Open a data channel
unless (&do_ftp_cmd(150, "stor $remote")) {
$ftp_error .= "¥nFile $remote not stored on $Host¥n";
close DFILE;
return undef;
}
&macchat'expect($Data_handle, 0); # Force macchat to do an accept
while (<DFILE>) {
chop;
&macchat'print($Data_handle, "$_¥015¥012");
}
close DFILE;
&macchat'close($Data_handle); # Close the data channel
&do_ftp_cmd(226);
}
#######################################################
# Do a simple name list ("ls")
sub list { ## Public
&do_ftp_listing("nlst", @_);
}
#######################################################
# Make a remote directory
sub mkdir { ## Public
&do_ftp_cmd(257, "mkd", @_);
}
#######################################################
# Open an ftp connection to remote host
sub open { ## Public
if ($NeedsClose) {
$ftp_error = "Connection still open to $Host!";
return undef;
}
$Host = shift(@_);
local($Port) = $FTP;
if ($Host =~ /(.*)¥s+([0-9]+)/) {
($Host, $Port) = ($1, $2);
}
local($User, $Password, $Acct) = @_;
$User = "anonymous" unless $User;
$Password = "-" . $main'ENV{'USER'} . "@$Myhost" unless $Password;
$ftp_error = '';
unless($Control =
&macchat'open_port(
&GUSI'AF_INET, &GUSI'pack_sockaddr_in(&GUSI'AF_INET, $Host, $Port))) {
$ftp_error = "Unable to connect to $Host";
if ($Port == $FTP) {
$ftp_error .= " ftp port: $!";
} else {
$ftp_error .= " port $Port: $!";
}
return undef;
}
unless(&macchat'expect($Control, 60,
'^220 .*¥015¥012', "1",
'^¥d¥d¥d .*¥015¥012', "undef")) {
$ftp_error = "Error establishing control connection to $Host";
&macchat'close($Control);
return undef;
}
&do_ftp_signals($NeedsClose = 1);
unless (&do_ftp_cmd(331, "user $User")) {
$ftp_error .= "¥nUser command failed establishing connection to $Host";
return undef;
}
unless (&do_ftp_cmd("(230|332|202)", "pass $Password")) {
$ftp_error .= "¥nPassword command failed establishing connection to $Host";
return undef;
}
return 1 unless $Acct;
unless (&do_ftp_cmd("(230|202)", "pass $Password")) {
$ftp_error .= "¥nAcct command failed establishing connection to $Host";
return undef;
}
1;
}
#######################################################
# Get name of current remote directory
sub pwd { ## Public
if (&do_ftp_cmd(257, "pwd")) {
$ftp_matched =~ m/^257 (.+)¥015?¥012/;
$1;
} else {
undef;
}
}
#######################################################
# Rename a remote file
sub rename { ## Public
local($from, $to) = @_;
&do_ftp_cmd(350, "rnfr $from") && &do_ftp_cmd(250, "rnto $to");
}
#######################################################
# Set transfer type
sub type { ## Public
&do_ftp_cmd(200, "type", @_);
}
###########################################################################
#
# The following are intended to be utility routines used only locally.
# Users should not call these directly.
#
###########################################################################
sub do_ftp_cmd { ## Private
local($okay, @commands, $val) = @_;
$ftp_echo && $commands[0] &&
print STDERR join(" ", @commands) . "¥015¥012";
$commands[0] &&
&macchat'print($Control, (join(" ", @commands) . "¥015¥012"));
&macchat'expect($Control, 60,
"^$okay .*¥¥015¥¥012", 'print STDERR $& if $ftp_echo;
$ftp_matched = $&; 1',
"^(¥d)¥d¥d .*¥¥015¥¥012", '($String = $&) =~ y/¥015¥012//d;
print STDERR $& if $ftp_echo;
$ftp_error = qq{Unexpected reply for ' .
"@commands" . ': $String};
$1 > 3 ? undef : 1',
@std_actions
);
}
#######################################################
sub do_ftp_listing { ## Private
local(@lcmd) = @_;
@ftp_list = ();
$ftp_trans_flag = 0;
return undef unless &do_open_dport;
return undef unless &do_ftp_cmd(150, @lcmd);
do { # Following is grotty, but macchat2 makes us do it
&macchat'expect($Data_handle, 30,
'(.*¥n?¥012)', 'push(@ftp_list, $1)',
"EOF", '$ftp_trans_flag = 1');
} until $ftp_trans_flag;
&macchat'close($Data_handle);
return undef unless &do_ftp_cmd(226);
grep(y/¥015¥012//d, @ftp_list);
@ftp_list;
}
#######################################################
sub do_open_dport { ## Private
local(@foo, $fam, $addr, $port) = &macchat'open_listen(&GUSI'AF_INET);
($port, $Data_handle) = @foo;
($fam,$addr,$port) = &GUSI'unpack_sockaddr_in($port);
unless ($Data_handle) {
$ftp_error = "Unable to open data port: $!";
return undef;
}
$addr =~ tr/./,/;
@foo = ($port >> 8, $port & 0xff);
$addr .= "," . join(',', @foo);
&do_ftp_cmd(200, "port $addr");
}
#######################################################
#
# To cleanup after a problem
#
sub do_ftp_abort {
die unless $NeedsClose;
&macchat'print($Control, "abor", "¥015¥012");
&macchat'close($Data_handle);
&macchat'expect($Control, 10, '.', undef);
&macchat'close($Control);
close DFILE;
unlink($NeedsCleanup) if $NeedsCleanup;
die;
}
#######################################################
#
# To set signals to do the abort properly
#
sub do_ftp_signals {
local($flag, $sig) = @_;
local ($old, $new) = ('DEFAULT', "ftp'do_ftp_abort");
$flag || (($old, $new) = ($new, $old));
foreach $sig (@sigs) {
($SIG{$sig} == $old) && ($SIG{$sig} = $new);
}
}
1;